dim r
r = inputbox("r=?",r,"1")

dim doc
set doc = application.activedocument

doc.unit = 4'mm
dim v
Set v = doc.ActiveView 
dim dx
dx = 0.15

dim xc,yc
dim isSet
isSet = false

Application.StatusBarText ="Select Pin,via,component or drawing"
Set selected = doc.GetObjects(9999, ,TRUE) 
if selected.count=1 then
	For Each ob In selected 
		select case ob.ObjectType
			case 1 'component
				isSet = true
			case 3 'pin
				isSet = true
			case 4 'via
				isSet = true
			case 13 'drawing
				isSet = true
		end select		
		if isSet = true then
			xc = ob.PositionX
			yc = ob.PositionY
		end if		
	Next ob	
else
	xc = v.PointerX
	yc = v.PointerY
end if
dim ws : set ws = CreateObject("WScript.Shell")
Application.StatusBarText ="set mark location = " & xc & "," & yc
dim regPath : regPath ="HKEY_CURRENT_USER\Software\MyApp\PADS\"
ws.RegWrite regPath & "xc", xc, "REG_EXPAND_SZ"
ws.RegWrite regPath & "yc", yc, "REG_EXPAND_SZ"
set ws = nothing

if doc.LayerEnabled(65) then
	Application.ModelessCmd("l 65")
	Application.ExecuteCommand("Display Colors Setup")
	DisplayColorsSetupDlg.ColorGrid.Cell("Layer_65", "#") = "1"
	DisplayColorsSetupDlg.ColorGrid.ClearSelection
	DisplayColorsSetupDlg.SelectedColor.SetActive (14)
	DisplayColorsSetupDlg.ColorGrid.Cell("Layer_65", "Copper") = "14"
	DisplayColorsSetupDlg.ColorGrid.Cell("Layer_65", "2D Lines") = "14"
	DisplayColorsSetupDlg.Ok.Click()
	

	dim x1,x2,y1,y2
	x1 = xc
	x2 = xc+r
	y1 = yc
	y2 = yc+r
	dim curlyr
	dim unit_str
	unit_str = "mm"
	
	dim tmpfile
	tmpfile = doc.path & "\tmp1.mcr"

	dim ostr
	ostr = "dim curlyr" & chr(13) & chr(10)
	ostr = ostr & "curlyr = doc.activelayer" & chr(13) & chr(10)
	ostr = ostr & "Application.HideBar(""Design Toolbar"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ShowBar(""Drafting Toolbar"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add 2D Line Polyline"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Drafting Circle Mode"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ModelessCommand(""hc"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Down"", " & x1 & unit_str & ", " & y1 & unit_str & ")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Select"", " & x1 & unit_str & ", " & y1 & unit_str & ")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add Corner To Drafting"", " & x1 & unit_str & ", " & y1 & unit_str & ") "& chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add Corner To Drafting"", " & x2 & unit_str & ", " & y2 & unit_str & ") "& chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Complete Drafting"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Cancel"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Down"", " & x2 & unit_str & ", " & y2 & unit_str & ")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Select"", " & x2 & unit_str & ", " & y2 & unit_str & ")" & chr(13) & chr(10)
	ostr = ostr & "doc.activelayer=curlyr" & chr(13) & chr(10)
	
	Dim fso,fw
	Set fso = CreateObject("scripting.filesystemobject")
	Set fw = fso.CreateTextFile(tmpfile,True)
	fw.Write ostr
	fw.close
	Set fw = Nothing	
	Set fso = Nothing			
	application.RunMacro(tmpfile,"")
end if

